home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb7.arc / PTOOLDAT.PAS < prev    next >
Pascal/Delphi Source File  |  1985-02-23  |  7KB  |  168 lines
  1. Program PTOOLDAT;  {Copyright  R D Ostrander
  2.                                Ostrander Data Services
  3.                                5437 Honey Manor Dr
  4.                                Indianapolis  IN  46241
  5.  
  6.      This is a demonstration program for the Turbo Pascal subroutine PTOOLDAT
  7.      for date manipulations. Address any questions to the author at the above
  8.      address.                                                                }
  9.  
  10. {$V-}     { This parameter is necessary in order to pass String parameters
  11.             of other than 21 characters.                                     }
  12.  
  13. Var
  14.    Input       : String [21];
  15.    InGreg      : Array [1..20] of String [21];
  16.    InJul       : Array [1..20] of Real;
  17.    I,J,K       : Byte;
  18.    Done        : Boolean;
  19.    Ch          : Char;
  20.    Code, Short : Integer;
  21.  
  22.  
  23. {$I PTOOLDAT.INC}  {Include statement for PTOOLDAT functions and procedures  }
  24.  
  25.  
  26. BEGIN
  27.  
  28.      ClrScr;
  29.      Gotoxy (15,5); Write ('Demonstration of PTOOLDAT procedure.');
  30.      Gotoxy (15,7); Write ('PTOOLDAT and this program are copyrights');
  31.      Gotoxy (15,8); Write ('of R D Ostrander');
  32.      Gotoxy (15,9); Write ('   Ostrander Data Services');
  33.      Gotoxy (15,10); Write ('   5437 Honey Manor Dr');
  34.      Gotoxy (15,11); Write ('   Indianapolis  IN  46241');
  35.      Gotoxy (15,13); Write ('and have been placed in the public domain.');
  36.      Delay (4000);
  37.      ClrScr;
  38.  
  39.      Done := False;
  40.      Gotoxy (30,1); Write ('Gregorian Date Validation');
  41.      Gotoxy (1, 3); Write ('Enter up to 20 dates to be validated');
  42.      Writeln (' - give  Month, Day, and Year  - ie ', PTDGCurr);
  43.      Gotoxy (1, 5); Write ('Enter  X  to end');
  44.      I := 1;
  45.      While (I <= 20)
  46.        and (Done = False) do
  47.            Begin
  48.                 Gotoxy (1, I + 5);
  49.                 Write ('Enter date                ');
  50.                 Gotoxy (12, I + 5);
  51.                 Read (Input);
  52.                 Ch := Input [1];
  53.                 Gotoxy (32, I + 5);
  54.                 If UpCase (Ch) = 'X' then Done := True
  55.                 else
  56.                    If PTDGValid (Input) then
  57.                       Begin
  58.                            Write (Input, ' is a Valid Date              ');
  59.                            InGreg [I] := Input;
  60.                            I := I + 1;
  61.                       End
  62.                    else
  63.                       Write (Input, ' is not Valid  - Try Again     ');
  64.            End;
  65.  
  66.      ClrScr;
  67.      Done := False;
  68.      Gotoxy (30,1); Write ('Julian Date Validation');
  69.      Gotoxy (1, 3); Write ('Enter up to 20 dates to be validated');
  70.      Writeln (' - give  number as YYDDD - ie ', PTDJCurr:5:0);
  71.      Gotoxy (1, 5); Write ('Enter  X  to end');
  72.      J := 1;
  73.      While (J <= 20)
  74.        and (Done = False) do
  75.            Begin
  76.                 Gotoxy (1, J + 5);
  77.                 Write ('Enter date                ');
  78.                 Gotoxy (12, J + 5);
  79.                 Read (Input);
  80.                 Ch := Input [1];
  81.                 If (UpCase (Ch) = 'X') or (Ch = '') then Done := True
  82.                 else
  83.                    Begin
  84.                         Gotoxy (32, J + 5);
  85.                         Val (Input, InJul [J], Code);
  86.                         If Code <> 0 then InJul [J] := 0;
  87.                         If PTDJValid (InJul [J]) then
  88.                            Begin
  89.                                 Write (Input,
  90.                                        ' is a Valid Date                 ');
  91.                                 J := J + 1;
  92.                            End
  93.                         else
  94.                            Write (Input, ' is not Valid  -  Try Again    ');
  95.                    End;
  96.            End;
  97.  
  98.      ClrScr;
  99.      I := I - 1;
  100.      Gotoxy (30,1); Write ('Gregorian Date Manipulations');
  101.      Gotoxy (1, 3); Write ('Input                 Julian (Type B) (Type E)');
  102.      Gotoxy (48,3); Write ('Alternate (Day of Week) Short');
  103.      For K := 1 to I do
  104.          Begin
  105.               Gotoxy (1, K + 4); Write (InGreg [K]);
  106.               Gotoxy (23,K + 4); Write (PTDGtoJ (InGreg [K]):5:0);
  107.               PTOOLDAT_J_Type := 'B';
  108.               Gotoxy (30,K + 4); Write (PTDGtoJ (InGreg [K]):7:0);
  109.               PTOOLDAT_J_Type := 'E';
  110.               Gotoxy (39,K + 4); Write (PTDGtoJ (InGreg [K]):8:0);
  111.               PTOOLDAT_J_Type := 'A';
  112.               PTOOLDAT_G_Order := 'YMD';
  113.               PTOOLDAT_G_Sep1 := '-';
  114.               PTOOLDAT_G_Sep2 := '-';
  115.               PTOOLDAT_G_ZeroSup := False;
  116.               PTOOLDAT_G2_Order := 'MDY';
  117.               Gotoxy (48,K + 4); Write (PTDGtoG (InGreg [K]));
  118.               PTOOLDAT_G_Order := 'MDY';
  119.               PTOOLDAT_G_Sep1 := '/';
  120.               PTOOLDAT_G_Sep2 := '/';
  121.               PTOOLDAT_G_ZeroSup := False;
  122.               PTOOLDAT_G2_Order := 'YMD';
  123.               PTOOLDAT_Day_Type := 9;
  124.               Gotoxy (58,K + 4); Write (PTDGDay (InGreg [K]));
  125.               PTOOLDAT_Day_Type := 3;
  126.               Short := PTDGtoS (InGreg [K]);
  127.               Gotoxy (72,K + 4); Write (Short:6);
  128.               Gotoxy (80,K + 4);
  129.               If Short = -32766 then Write ('*');
  130.          End;
  131.      Gotoxy (1, 25); Write ('Press any key to continue');
  132.      Read (KBD, Ch);
  133.  
  134.      ClrScr;
  135.      J := J - 1;
  136.      Gotoxy (30,1); Write ('Julian Date Manipulations');
  137.      Gotoxy (1, 3); Write ('Input Gregorian  or');
  138.      Gotoxy (40,3); Write ('Day LeapYr +100 Days Minus Prev Date');
  139.      For K := 1 to J do
  140.          Begin
  141.               Gotoxy (1, K + 4); Write (InJul [K]:5:0);
  142.               Gotoxy (7, K + 4); Write (PTDJtoG (InJul [K]));
  143.               PTOOLDAT_G_YrDisp := 4;
  144.               PTOOLDAT_G_MoDisp := 9;
  145.               PTOOLDAT_G_Sep1   := ' ';
  146.               PTOOLDAT_G_Sep2   := ', ';
  147.               PTOOLDAT_G_ZeroSup := True;
  148.               Gotoxy (18,K + 4); Write (PTDJtoG (InJul [K]));
  149.               PTOOLDAT_G_YrDisp := 2;
  150.               PTOOLDAT_G_MoDisp := 2;
  151.               PTOOLDAT_G_Sep1   := '/';
  152.               PTOOLDAT_G_Sep2   := '/';
  153.               PTOOLDAT_G_ZeroSup := False;
  154.               Gotoxy (40,K + 4); Write (PTDJDay (InJul [K]));
  155.               Gotoxy (44,K + 4);
  156.               If PTDJLeap (InJul [K]) then Write ('Yes')
  157.                                       else Write ('No');
  158.               Gotoxy (51,K + 4); Write (PTDJtoG (PTDJAdd (InJul [K], 100)));
  159.               If K > 1 then
  160.                  Begin
  161.                       Gotoxy (61,K + 4);
  162.                       Write (PTDJComp (InJul [K], InJul [K-1]):8:0, ' Days');
  163.                  End;
  164.          End;
  165.  
  166. Gotoxy (1, 24);
  167.  
  168. END.